---
title: "F.S.Bellelli ---  City of London"
output: 
  flexdashboard::flex_dashboard:
    storyboard: true
    source: embed
---

```{r setup, include=FALSE}
library(flexdashboard)
library(dygraphs)
library(leaflet)
library(tidyverse)
library(plotly)
library(htmltools)

months <- data.frame(name=c("January","February","March","April","May","June","July","August","September","October","November","December"), number = sprintf("%02d",seq(1,12)))
```

### This case study will focus on the City of London

![City of London (Image source: Wikipedia)](https://fbellelli.com/images/city2.jpg)



### **1)** The City of London is an iconic location for office space. 

```{r}
leaflet() %>% 
  addTiles() %>%
#  addProviderTiles(providers$Stamen.TonerLite) %>%
#  addProviderTiles(providers$Stamen.Watercolor) %>%
#  addProviderTiles(providers$CartoDB.Positron) %>%
#  addProviderTiles(providers$Stadia.AlidadeSmooth) %>%
#  addProviderTiles(providers$Thunderforest.Pioneer) %>%
#  addProviderTiles(providers$Thunderforest.Neighbourhood) %>%
   addRectangles(
    lng1=-0.079, lat1=51.520,
    lng2=-0.105, lat2=51.5085,
    fill=TRUE,
    fillColor = "navy",
    fillOpacity = 0.08
  )%>%
  addMarkers(lng=-0.09203944557623281, lat=51.513219744574855, popup="City of London") 
```

***

The City of London is an iconic location for office space

- Located in central London, the City is the primary business district of London.

- The city has special administrative status. It is considered a separate "city" within London. 

- As a result, the City enjoys regulatory independence.

- The City has a surface of only $2.9km^2$. Hence, new real-estate developments often take the form of high-rise buildings.

- In 2016, the City only had 9,400 residents, but over 500,000 persons regularly commuting for work.

### **2)** The City is the beating heart of London's financial, legal and international business activity 


Take-up by business sector
Infogram


***

- The City of London is a global financial district. However, only 9% of its office space is directly occupied by the financial and insurance industry. 

- The legal industry occupies almost a third of all office space. Many international law firms have their headquarter in the "Magic Circle" in the City of London.

- Media and Tech businesses occupy 34% of office space. For instance, Amazon UK has its headquarters here. Several publishing and newspaper companies also have their offices in the City (famously on *Fleet street*). This category also includes a large number fintech companies. 

- In the past, business and retail services had a strong presence in the City, but they have now moved to the West End.





### **3)** Like the rest of Europe, the City's office market has been heavily affected by the pandemic 



```{r, fig.align='center'}
data <- read.csv("clean data/SAVILLS city office market watch data.csv")
colnames(data)[1]<-"Date"
data$month <- str_sub(data$Date,1,-6)
data$year <- str_sub(data$Date,-4,-1)
data <- left_join(data,months,by=c("month"="name"))
data$date <- as.Date(paste0(data$year,"-",data$number,"-01"))
data$takeup <- as.numeric(str_replace_all(data$takeup,",",""))
data$X12m_takeup <- as.numeric(str_replace_all(data$X12m_takeup,",",""))
data$gradeA_rent <- as.numeric(str_replace_all(data$gradeA_rent,"£",""))
data$vacancy_rate <- as.numeric(str_replace_all(data$vacancyrate,"%",""))
data$takeup_12m <- (data$X12m_takeup/ 10.764)/1000    #convert to sq metres


ggplot(data, aes(x = date, y = vacancy_rate)) +
            annotate(geom = "rect", xmin = as.Date("2020-02-01"), xmax = as.Date("2021-08-01"), ymin = 0, ymax = 10, fill = "navy", alpha = 0.05)+
            geom_line(colour="navy", size=1.3)+
            geom_line(aes(x=date,y=(takeup_12m-200)/73.5), colour="firebrick", size=1.3)+
            scale_y_continuous("Vacancy rate (%)",limits= c(0,10), expand= c(0,0), sec.axis = sec_axis(~.*73.5 + 200 , name = "12 months take-up (thousand of sq metres) ")) +
            scale_x_date("Year",expand=c(0,0))+
            theme_bw()+
            annotate(geom="text", x=as.Date("2020-11-01"), y=9.5, label="COVID-19",  color="black", size=4) +
            annotate(geom="text", x=as.Date("2019-01-01"), y=8, label="Office space take-up\nCity of London (rhs)",  color="firebrick", size=3.5) +
              annotate(geom="text", x=as.Date("2019-01-01"), y=4.3, label="Office vacancy rate\nCity of London (lhs)",  color="navy", size=3.5) +
            labs(caption="Data source: Savills")



#ggplotly(p) %>% 
#  layout(yaxis2 = list(overlaying = "y",
#  side = "right",
#  title = "12 months take-up (thousand of sq metres)"))

```

***

The pandemic has shaken London City's office market. 

- In 2021 vacancy rate was historically high. Almost 10% of all office property is not currently occupied.

- As the pandemic unfolded, many companies decided to cut their office space. 

- This demand shock weighted negatively on office rental prices.



### **4)** Conversely, remote working increased demand for residential space in London and pushed home prices upward.

```{r}
data <- read.csv(file = "clean data/house price index london.csv")
data$month <- str_sub(data$Date,1,-6)
data$year <- str_sub(data$Date,-4,-1)
data <- left_join(data,months,by=c("month"="name"))
data$date <- as.Date(paste0(data$year,"-",data$number,"-01"))

# data <- as.data.frame(data)[,c("date","house_price_index_london")]
# data <- xts::xts(data[,2], order.by = data[,1])
# dygraph(data) %>%
#   dySeries("V1", label="London house price index", color="navy", strokeWidth = 3) %>%
#   dyRangeSelector() %>%
#   dyAxis("y", label = "London house price index") %>%
#   dyShading(from = "2020-2-1", to = "2021-9-1") %>%
#   dyEvent("2020-2-1", "COVID-19 in the UK", labelLoc = "bottom")


ggplot(data, aes(x = date, y = house_price_index_london)) +
            annotate(geom = "rect", xmin = as.Date("2020-02-01"), xmax = as.Date("2021-08-01"), ymin = 110, ymax = 130, fill = "navy", alpha = 0.05)+
            geom_line(colour="navy", size=1)+
            scale_y_continuous("London house price index",limits= c(110,130), expand= c(0,0)) +
            scale_x_date("Year",expand=c(0,0))+
            theme_bw()+
            annotate(geom="text", x=as.Date("2020-11-01"), y=128, label="COVID-19",  color="black", size=4)+ 
  labs(caption="Data source: UK Land Registry")

# ggplotly(p)
```

***

- A large proportion of City's workers are still working from home.  

- Remote working increased demand for residential space in London and pushed home prices upward.


### **5)** The worst of the pandemic seems to have passed and vaccination rate is high in London

```{r}


deaths <- read.csv("clean data/covid_ons_deaths_cqc_by_la.csv")
cases <- read.csv("clean data/covid_phe_cases_london_boroughs.csv")
cases <- cases %>% group_by(date) %>% summarise(new_cases = sum(new_cases),
                                                total_cases = sum(total_cases),
                                                .groups = "drop")
deaths <- deaths %>% filter(cause_of_death == "COVID 19") %>% group_by(date) %>%
          summarise(deaths = sum(deaths), .groups="drop")

corona <- full_join(cases,deaths, by="date")
corona <- corona %>% 
  mutate(new_cases = zoo::rollapplyr(new_cases, 7, mean, na.rm = TRUE, fill=NA),
         deaths = zoo::rollapplyr(deaths, 7, mean, na.rm = TRUE, fill=NA))
corona$date <- as.Date(corona$date)
corona <- as.data.frame(corona)
corona$total_cases <- NULL

corona <- xts::xts(corona[,2:3],order.by = corona[,1])

dygraph(corona, group="covid")%>% 
  dySeries("new_cases", label="New cases", strokeWidth = 2) %>%
  dySeries("deaths", axis = 'y2', label="Deaths", strokeWidth = 3) %>%
  dyOptions(colors = c("navy","firebrick"), fillGraph = TRUE, fillAlpha = 0.3, stepPlot = TRUE) %>%
  dyRangeSelector(dateWindow = c("2021-01-01", "2021-08-01")) %>%
  dyAxis("y", label = "New cases") %>%
  dyAxis("y2", label = "Deaths")


# vaccination <- read.csv("clean data/covid_phe_vaccines_age_london_boroughs.csv")
# vaccination <- vaccination %>% group_by(date, dose) %>%
#                summarise(cum_doses = sum(cum_doses),
#                          cum_prop = sum(cum_doses)/sum(population),.groups ="drop")
# vaccination$dose <- str_replace_all(vaccination$dose, "1st ","first_")
# vaccination$dose <- str_replace_all(vaccination$dose, "2nd ","second_")
# vaccination$cum_prop <- 100*vaccination$cum_prop





# prova <- pivot_wider(vaccination[,c(1:2,4)],id_cols="date",values_from ="cum_prop",names_from="dose") %>% as.data.frame()
# prova$date <- as.Date(prova$date)
# prova <- xts::xts(prova[,2:3],order.by = prova[,1])
# 
# dygraph(prova,main="... thanks to UK's high vaccination rate", group="covid")%>%
#    dySeries("second_dose", label="Second dose", strokeWidth = 2, color="navy", fillGraph = TRUE) %>%
#    dySeries("first_dose", label="First dose", strokeWidth = 2, color="cornflowerblue", fillGraph = TRUE) %>%
#   dyOptions(stepPlot = FALSE, fillAlpha = 0.7) %>%
#   dyRangeSelector(dateWindow = c("2021-01-01", "2021-08-01")) %>%
#   dyAxis("y", label = "Vaccination rate (%)", valueRange = c(0, 101)) 



# ggplot(vaccination)+
#   geom_ribbon(aes(x=as.Date(date), ymin=0, ymax=cum_prop*100, alpha=dose),fill="navy", size=1.3, show.legend = FALSE)+
#   theme_bw()+
#   labs(x="Date",y="Vaccination rate of London residents (%)", caption = "Data source: Public Health England")+
#   annotate(geom="text", x=as.Date("2021-07-10"), y=25, label="Second dose",  color="white", size=4) +
#   annotate(geom="text", x=as.Date("2021-07-10"), y=65, label="First dose",  color="navy", size=4) +
#   scale_x_date(date_labels = "%b/%Y", limits=as.Date(c("2020-12-08","2021-08-10")),
#                breaks= seq.Date(as.Date("2021-01-01"),as.Date("2021-08-01"), by="month"), expand=c(0,0))+
#   scale_y_continuous(limits = c(0,100),expand=c(0,0))+
#   theme(panel.grid.minor.x = element_blank())
# 


```


***

- The UK was hit hard by the pandemic, but the worst seems to have passed

- London has a high vaccination rate. More than 80% of the population has received at least the first dose of vaccination and more than 60% already received their second dose.

- The hight vaccination rate protected the population during the latest surge of the Delta variant. Unlike previous surges, the number of hospitalisation and deaths rose only moderately following the boom in cases.


### **6)** As a result, people are gradually returning to the City's offices


```{r,fig.width=10, fig.asp=0.5, fig.align ="center"}
library(data.table)
library(zoo)
data <- fread("clean data/mobility_report_europe.csv")
data <- data[`sub region 2`=="City of London", c("date","workplaces") ]
data <- data %>% mutate(work = c(NA,NA,zoo::na.approx(workplaces)),
                        smooth = zoo::rollapplyr(work, 7, sum, na.rm = TRUE, fill=NA)/7)

ggplot(data, aes(x=as.Date(date), y=workplaces))+
  geom_hline(yintercept = 0)+
  geom_line(colour="navy",alpha=0.3)+
  geom_line(aes(x=as.Date(date), y=smooth), colour="navy", size=1.3)+
  theme_bw()+
  labs(x="Date",y="Google mobility index (% compared to baseline)", caption = "Data source: Google")+
  annotate(geom="text", x=as.Date("2021-06-10"), y=-43, label="7-days travel to\n City's workplaces",  color="navy", size=4) +
  scale_x_date(date_labels = "%b/%Y", limits = as.Date(c("2020-02-17","2021-09-01")), expand=c(0,0))

```



***

- COVID restriction in the UK have been almost completely lifted. 

- However, mobility data shows a slow return to offices for the moment. 

- Physical presence in the City will probably increase more sharply when the latest COVID surge ebbs away.

- To some extent, teleworking and alternative working arrangement will probably remain in place even after the end of the pandemic. This could reduce the demand for large office spaces.  



### **7)** Despite Brexit and COVID-19, the City has solid growth prospects


```{r, fig.align="center"}
population <- read.csv("clean data/population projection london.csv")
population <- population[population$borough == "London (total)", c("year","population","international.net","domestic.net","total.change")]
population$population <- population$population/1000000

gdp <- read.csv("clean data/GDP forecast IMF July 2021 WO.csv")

data <- full_join(gdp,population, by="year") %>% as.data.frame()



# data <- xts::xts(data[,2:6],order.by = as.Date(as.character(data[,1]), format="%Y"))
# dygraph(data[,2:3])%>% 
#   dySeries("GDP_n", label="GDP UK", strokeWidth = 2) %>%
#   dySeries("population", axis = 'y2', label="London population", strokeWidth = 2) %>%
#   dyOptions(colors = c("navy","firebrick"), fillGraph = FALSE, stepPlot = FALSE) %>%
#   dyRangeSelector(dateWindow = c("2009-01-01", "2031-01-01")) %>%
#   dyAxis("y", label = "GDP (billion USD)") %>%
#   dyAxis("y2", label = "Population of London (millions)") %>%
#   dyShading(from = "2021-1-1", to = "2050-1-1") %>%
#   dyEvent("2021-1-1", "Forecast", labelLoc = "bottom")


ggplot(data)+
  annotate(geom = "rect", xmin = 2020.5, xmax = 2050, ymin = 0, ymax = 4500, fill = "navy", alpha = 0.05)+
  geom_line(data=data[data$year<2021,],mapping=aes(x=year,y=(population-8)*1600), colour="firebrick", size=1.3)+
  geom_line(data=data[data$year>=2021,],mapping=aes(x=year,y=(population-8)*1600), colour="firebrick", size=1.3, linetype="dashed")+
  geom_line(data=data[data$year<2021,],mapping=aes(x=year,y=GDP_n), colour = "navy", size=1.3)+
  geom_line(data=data[data$year>=2021,],mapping=aes(x=year,y=GDP_n), colour = "navy", size=1.3, linetype= "dashed")+
  scale_y_continuous("GDP (in billion USD)",limits= c(0,4500), expand= c(0,0), sec.axis = sec_axis(~./1600 + 8 , name = "Population of London (in millions)"))+
  scale_x_continuous("Year",limits= c(1980,2050), expand= c(0,0))+
  theme_bw()+
  labs(caption="Data source: Greater London Authority / IMF July 2021 GDP forecasts")+
  annotate(geom="text", x=2036, y=300, label="FORECAST",  color="navy", size=4)+
  annotate(geom="text", x=2004, y=900, label="Population of London\n(rhs)",  color="firebrick", size=3.5) +
  annotate(geom="text", x=1988, y=1500, label="GDP (lhs)",  color="navy", size=3.5)

 
```


***

- Despite Brexit and COVID-19, the City has solid growth prospects and the City is unlikely to lose its position as financial and business hub. 

- London remains an attractive place for international corporations and finance. It offers easy access to skilled workforce, a supportive government, good infrastructures, easy access to customer base, and the opportunity to enter in the local network of businesses and tech clusters.

- London population is expected to reach 10 million by 2040. Much of this population will come from international immigration.

- In its latest forecast, the IMF predicts the British economy will grow at 5% rate in 2021 and 2022 and almost 2% until 2025.

- Given the uniqueness of the location and the limited supply, prospects for the office market in the City are positive in the long run.



### **8)** A simple model of the City's office market


Using the data from this case study we can build a simple model of London's office market. We predict the vacancy rate of the City's office using data on UK's GDP growth, London's population growth and Google's mobility data. The first two variables are used to capture the *push* and *pull* factors of the economy and the long-term prospects of the London market. We hypothesise that a growing London population and economy should be associated with above average demand for office space, whereas recessions and waning population are a sign of weak demand. Finally, mobility data provides information on remote working and COVID evolution. We specify our model in the following way:


$$ \operatorname{logit}(vacancy_q) =\alpha + \sum^{r}_{k=0}\beta_k \cdot \Delta GDP_{q-k} + \sum^{s}_{h=0}\gamma_h \cdot \Delta Population_{q-h} + \delta_1 \cdot  Mobility_q + \delta_2 \cdot  Mobility_q \cdot \overline{M(\theta)}_q + \delta_3 \cdot \overline{M(\theta)}_q + \epsilon$$

A fractional logit specification is used because vacancy rate is a bounded outcome variable. This ensures consistency of predicted values. All the data is taken at a quarterly frequency $q$. The mobility and vacancy data --- which are available at higher frequency --- can either be aggregated through simple averaging or by using a parametrization of the monthly data (e.g. MIDAS with almon lags).

The parameter $\alpha$ gives the rest vacancy rate of the model. For GDP and Population growth we introduce a set of $r$ / $s$ lags to better capture the dynamics of shocks. The Mobility variable is interacted with a dummy variable $\overline{M(\theta)}$ which takes the value of one if $Mobility$ is smaller than a threshold value $\theta$. The interaction term in included to introduce non-linearity in the relationship with mobility. For example, this could help coping with the behaviour of certain businesses which decide to cut their office space or eliminate their physical presence when work is done entirely remotely.


The parameters $\alpha$, $\beta$, $\gamma$ and $\delta$ can be estimated using a maximum likelihood estimator or iterative least square method. Whereas, the hyperparameters $\theta$ and the lag lengths $r$ and $s$ are chosen by minimising a suitable statistic, such as the Akaike or Bayesian information criteria. 


Once the parameters of the model are estimated, a forecast can by generated by using the GDP and population forecasts presented in slide 7. Three different scenarios can be developed: 1) a *COVID disaster* in which remote working prevails for longer period, 2) a *full return* in which workers will fully return to physical presence, and 3) a *mixed scenario* in which workers will return to work from their office but a fraction of the workforce will continue to work remotely.